home *** CD-ROM | disk | FTP | other *** search
/ Aminet 16 / Aminet 16 (1996)(GTI - Schatztruhe)[!][Dec 1996].iso / Aminet / dev / src / wangisrc.lha / wangi / z / Shrub / TreeIt.PAS < prev    next >
Pascal/Delphi Source File  |  1995-07-29  |  3KB  |  154 lines
  1. (*
  2.  * Shrub... HSPascal source
  3.  *
  4.  * ©Lee Kindness
  5.  *
  6.  * TreeIt.pas
  7.  *
  8.  *)
  9.  
  10. Function AllocTree;
  11.     
  12. Begin
  13.     th := AllocVec(Sizeof(tTreeHandle), MEMF_CLEAR);
  14.     If th <> NIL then begin
  15.         th^.th_List := AllocRemember(@th^.th_RK, SizeOf(tList), MEMF_CLEAR);
  16.         if th^.th_List <> NIL then begin
  17.             NewList(th^.th_List);
  18.         End else Begin
  19.             FreeVec(th);
  20.             th := NIL
  21.         End;
  22.     End;
  23.     AllocTree := th;
  24. End;
  25.  
  26. Procedure FreeTree;
  27.  
  28. Begin
  29.     if th <> NIL then begin
  30.         UnLock(th^.th_Loc);
  31.         FreeRemember(@th^.th_RK, True);
  32.         FreeVec(th);
  33.         th := NIL;
  34.     End;
  35. End;
  36.  
  37.  
  38. Procedure FormatName;
  39.  
  40. VAR 
  41.     tmp : string;
  42.     tns, numstxt, z : byte;
  43.     n   : pmn;
  44.  
  45. begin        
  46.     tmp := PtrToPas(th^.th_Name);
  47.     tns := Byte(tmp[0]);
  48.     
  49.     if dt > 0 then begin
  50.         Case dt of
  51.             ST_SOFTLINK : tmp := tmp + ' (dir) <sl>';
  52.             ST_LINKDIR : tmp := tmp + ' (dir) <hl>';
  53.             Else tmp := tmp + ' (dir)';
  54.         End;
  55.     End;
  56.     if dt < 0 then begin
  57.         Case dt of
  58.             ST_LINKFILE : tmp := tmp + ' <hl>';
  59.             ST_PIPEFILE : tmp := tmp + ' <pipe>';
  60.         End;
  61.     End;
  62.             
  63.     numstxt := 0;
  64.     for z := 2 to DirLevel do begin
  65.         inc(numstxt); 
  66.         tmp := Arg.arg_Stxt + tmp;
  67.     End;
  68.         
  69.     if Pos('.info',tmp) <> 0 then begin
  70.         if NOT arg.arg_ShowIcons then begin
  71.             tmp := '';
  72.         End;
  73.     End;
  74.     
  75.     inc(tnumf);
  76.     if tmp <> '' then begin
  77.         inc(numf);
  78.         n := AllocRemember(@th^.th_RK, Sizeof(tmn), MEMF_CLEAR);
  79.         if n <> NIL then begin
  80.             n^.ln_Name := CStrConstPtrAR(@th^.th_RK, tmp);
  81.             n^.ln_AbsNameSize := tns;
  82.             n^.ln_DirEntryType := dt;
  83.             n^.ln_NumSTxt := numstxt;
  84.             AddTail(th^.th_List, pNode(n));
  85.         End;
  86.     End;
  87. end;
  88.  
  89.  
  90. Procedure CreateTree; 
  91.  
  92.  
  93. VAR
  94.     olddir, l : BPTR;
  95.     OKRes     : Boolean;
  96.     fib       : pFileInfoBlock;
  97.     tmpn      : byte;
  98.     dn : integer;
  99.  
  100. CONST
  101.     n : Byte = 0; { holds the current number of recurses }
  102.     
  103. Begin 
  104.     if initial then begin
  105.         empty := False;
  106.         n := 0;
  107.         tnumf := 0;
  108.         numf := 0;
  109.         numd := 0;
  110.     End;
  111.     inc(n);
  112.     OldDir := CurrentDir(th^.th_Loc);
  113.     Fib := AllocVec(sizeof(tFileInfoBlock),MEMF_CLEAR);
  114.     if fib <> NIL then begin
  115.         dn := 0;
  116.         OKRes := Examine(th^.th_Loc,fib);
  117.         While OKRes do begin
  118.             inc(dn);
  119.             if (fib^.fib_DirEntryType > 0) and (dn <> 1) then begin
  120.                 inc(numd);
  121.                 th^.th_Name := @fib^.fib_FileName;
  122.                 FormatName(n, fib^.fib_DirEntryType, th);
  123.                 
  124.                 if (fib^.fib_DirEntryType = ST_LINKDIR)|(fib^.fib_DirEntryType = ST_SOFTLINK) then
  125.                     OK := False
  126.                 else
  127.                     OK := True;
  128.                     
  129.                 If arg.arg_fld then
  130.                     OK := true;
  131.                     
  132.                 If Ok then begin
  133.                     tmpn := n;
  134.                     l := th^.th_Loc;
  135.                     th^.th_Loc := lock(@fib^.fib_FileName, ACCESS_READ);
  136.                     CreateTree(th, False); { recurse }
  137.                     n := tmpn;
  138.                     unlock(th^.th_Loc);
  139.                     th^.th_Loc := l;
  140.                 End;
  141.             end;
  142.             if (fib^.fib_DirEntryType < 0) then begin
  143.                 th^.th_Name := @fib^.fib_FileName;
  144.                 FormatName(n, fib^.fib_DirEntryType, th);
  145.             end;
  146.             
  147.             OKRes := ExNext(th^.th_Loc,fib);
  148.             
  149.         end;
  150.         FreeVec(fib);
  151.     end;
  152.     Olddir := Currentdir(olddir);
  153. end;
  154.